home *** CD-ROM | disk | FTP | other *** search
- Member('DOSLIB')
- OMIT('╝')
- ╔════════════════════════════════════════════════════════════════════════════╗
- ║ Change_Directory - !Generated Procedure ║
- ╚════════════════════════════════════════════════════════════════════════════╝
-
- Change_Directory PROCEDURE
-
- Directory STRING(64)
- Old_Directory String(64)
-
- DirQueue QUEUE
- DirLine STRING(15)
- .
-
- SCREEN SCREEN(11,61),PRE(SCR),SHADOW,EXPAND(7),ZOOM,CUA,COLOR(1)
- !style=D:\CLARION\DEVELOP\DOSLIB\CLARION.STY
- ROW(6,11) PAINT(1,1),COLOR(113)
- ROW(1,1) STRING('█{22}'),COLOR(113)
- COL(23) STRING('Change Directory'),COLOR(2)
- COL(39) STRING('█{23}'),COLOR(113)
- ROW(6,4) STRING('Current'),COLOR(113)
- COL(14) STRING(':'),COLOR(113)
- ROW(11,1) STRING('█▄{59}█'),COLOR(113)
- REPEAT(9)
- ROW(2,1) STRING('█'),COLOR(113)
- ROW(2,61) STRING('█'),COLOR(113)
- .
- ROW(4,4) PROMPT('Switch To :'),COLOR(4,5,40,6,7)
- COL(15) ENTRY(@s28),USE(Directory),COLOR(8,9,38)
- ROW(6,15) ENTRY(@s28),USE(Old_Directory),SKIP,COLOR(8,9,38)
- ROW(3,45) LIST(7,14),FROM(DirLine),VSCROLL,USE(?DirList),IMM,COLOR(21,22,68)
- ROW(9,9) BUTTON(' &Change |'),SHADOW,USE(?Change),COLOR(17,18,39,19,20)
- COL(31) BUTTON(' &Exit |'),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(17,18,39,19,20)
- .
-
- DirString CSTRING(64) !Used for Directory to search
- SaveDir LIKE(DirString) !Used to hold beginning path
-
- DirInfo GROUP !Necessary DOS file group
- BYTE,DIM(21) ! Used by findfirst
- Attrib BYTE ! Attribute in DOS format
- DosTime SHORT ! Time in DOS format
- DosDate SHORT ! Date in DOS format
- Filesize LONG ! Size in BYTES
- FileName CSTRING(13) ! File name
- END !End GROUP
-
-
- CODE
- OPEN(Screen) !Open the screen
- SaveDir = PATH() !Save the Starting Directory
- IF LEN(CLIP(SaveDir)) <> 3 !If not in the root directory
- SaveDir = CLIP(SaveDir) & '\' ! Add the trailing '\'
- END !End IF
- Directory = SaveDir !Set to the Current Directory
- Old_Directory = SaveDir
- DO FillQueues !Fill the screen queues
- LOOP !Main ACCEPT loop
- ACCEPT ! ACCEPT keyboard input
- CASE FIELD() ! Jump to field edit routine
-
- OF ?DirList ! Directory list field edit
- IF SELECTED() = ?DirList ! If staying on this field
- IF KEYCODE() = MouseLeft2 OR | ! On mouse double click
- KEYCODE() = EnterKey ! or the Enter Key
- GET(DirQueue,CHOICE()) ! Get the selected entry
- Directory = CLIP(Directory)&DirLine ! Create a new directory
- SETPATH(Directory) ! Set to the directory
- Directory = PATH() ! Reread the directory
- IF LEN(CLIP(Directory)) <> 3 ! If not in the Root
- Directory = CLIP(Directory) & '\' ! add the trailing \
- END ! End IF
- Do FillQueues ! Fill the screen queues
- SELECT(?DirList,1) ! Reset Dir List box
- END ! End IF
- END ! End IF
-
- OF ?Change ! Ok button field Edit
- Old_Directory = Path() ! Break out of screen LOOP
- SaveDir = Path()
- Display
- Select(?Directory)
-
- OF ?Cancel ! Cancel button field Edit
- SETPATH(SaveDir) ! Return to starting path
- FREE(DirQueue) ! Free the DirQueue memory
- BREAK ! Return to calling procedure
- END ! End CASE FIELD()
- END !End LOOP
- FREE(DirQueue) !Free the DirQueue memory
-
- FillQueues ROUTINE
-
- FREE(DirQueue) !Free the DirQueue
- DirString = CLIP(Directory) & '*.*' !Set the subdirectory mask
- IF NOT LEN(CLIP(DirString)) = 6 !If not in the root directory
- DirLine = '..\' ! Make prior directory entry
- ADD(DirQueue) ! Add to the DirQueue
- END !End IF
- IF DL:FindFirst(DirString,DirInfo,FA_DIREC) <> 0 !If unexpected error
- FREE(DirQueue) ! Clear the DirQueue
- RETURN ! Return
- END !End IF
- LOOP !While entries found
- IF FileName = '.' OR FileName = '..' ! If the dot entries
- IF DL:FindNext(DirInfo) <> 0 ! Get the next entry
- BREAK ! Break if unexpected error
- END ! End IF
- CYCLE ! Return to dot entry check
- END ! End IF
- IF BAND(ATTRIB,10H) ! If a subdirectory is found
- DirLine = FileName ! Fill the queue field
- ADD(DirQueue) ! Add to the DirQueue
- IF ERRORCODE() THEN BREAK. ! Break if unexpected error
- END ! End IF
- IF DL:FindNext(DirInfo) <> 0 ! Get the next entry
- BREAK ! Break if unexpected error
- END ! End IF
- END !End LOOP
- SORT(DirQueue,+DirLine) !Sort the directory listing
- DISPLAY !Display the new lists
-